import Control.Applicative
import Data.Char
import Data.Int
import Data.Word 
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.Char (isSpace)


-- file: ch10/PNM.hs
data Greymap = Greymap {
      greyWidth :: Int
    , greyHeight :: Int
    , greyMax :: Int
    , greyData :: L.ByteString
    } deriving (Eq)

-- file: ch10/PNM.hs
instance Show Greymap where
    show (Greymap w h m _) = "Greymap " ++ show w ++ "x" ++ show h ++ " " ++ show m


-- file: ch10/Parse.hs
data ParseState = ParseState {
      string :: L.ByteString
    , offset :: Int64           -- imported from Data.Int
    } deriving (Show)

-- file: ch10/Parse.hs
simpleParse :: ParseState -> (a, ParseState)
simpleParse = undefined

-- file: ch10/Parse.hs
betterParse :: ParseState -> Either String (a, ParseState)
betterParse = undefined

-- file: ch10/Parse.hs
newtype Parse a = Parse {
      runParse :: ParseState -> Either String (a, ParseState)
    }

-- file: ch10/Parse.hs
identity :: a -> Parse a
identity a = Parse (\s -> Right (a, s))


--identity2 :: a -> Parse a
identity2 a = \s -> Right (a, s)

-- file: ch10/Parse.hs
parse :: Parse a -> L.ByteString -> Either String a
parse parser initState
    = case runParse parser (ParseState initState 0) of
        Left err          -> Left err
        Right (result, _) -> Right result


{-
*Main> runParse (identity "a") (ParseState a 0)
Right ("a",ParseState {string = "ABCDEFGH", offset = 0})
-}        
        
-- file: ch10/Parse.hs
modifyOffset :: ParseState -> Int64 -> ParseState
modifyOffset initState newOffset =
    initState { offset = newOffset }

-- file: ch10/Parse.hs
-- import the Word8 type from Data.Word

-- runParse :: ParseState -> Either String (Word8, ParseState)

                

getState :: Parse ParseState
getState = Parse (\s -> Right (s, s))

putState :: ParseState -> Parse ()
putState s = Parse (\_ -> Right ((), s))

-- file: ch10/Parse.hs
bail :: String -> Parse a
bail err = Parse $ \s -> Left $
           "byte offset " ++ show (offset s) ++ ": " ++ err                


              
                      

            
--parseByteX :: Parse Word8
parseByteX =
   \initState ->
    case L.uncons (string initState) of
      Nothing ->
          bail "no more input"
      Just (byte,remainder) ->
          putState newState ==> \_ ->
          identity byte
        where newState = initState { string = remainder,
                                     offset = newOffset }
              newOffset = offset initState + 1              
{-

d = L.pack[0x41,0x42,0x43,0x44,0x45]
d2 = L.pack[0x51,0x52,0x53,0x54,0x55]

*Main> runParse (bail "error1") (ParseState d 2)
Left "byte offset 2: error1"
*Main>
 
 *Main> runParse (getState) (ParseState d 2)
Right (ParseState {string = "abcd", offset = 2},ParseState {string = "abcd", offset = 2})
*Main>

*Main> runParse (putState  (ParseState d2 34)) (ParseState d 3)
Right ((),ParseState {string = "QRSTU", offset = 34})
*Main>

*Main> runParse parseByte (ParseState d 2)
Right (65,ParseState {string = "BCDE", offset = 3})
*Main>

-}                   

                

            
parseByte1 :: Parse Word8
parseByte1 =
    Parse $ 
        \initState ->Right (   fst (dropJust (L.uncons (string initState))) , initState)  
        
  
        
        
parseByte2 :: Parse Word8
parseByte2 =
    Parse $ 
        \initState ->
    case L.uncons (string initState) of
      Just (byte,remainder) ->
         Right (byte, initState)
        
parseByte3 :: Parse Word8
parseByte3 =
    Parse $ 
        \initState ->
    case L.uncons (string initState) of
        Nothing ->
            bail3 initState "no more input"
        Just (byte,remainder) ->
            Right (byte, initState)
-- file: ch10/Parse.hs
bail3 :: ParseState->String -> Either String (a, ParseState)
bail3 s err = Left  $ "byte offset " ++ show (offset s) ++ ": " ++ err

d = L8.pack"a1b2c3d4e5f6g7"
d2 = L.pack[0x51,0x52,0x53,0x54,0x55]

--content <- L.readFile "p5a.pgm"
           
           
bail1 :: String -> Parse a
bail1 err = Parse $ \s -> Left (
           "byte offset " ++ show (offset s) ++ ": " ++ err)           

      
                      
--dropRight :: (Either b a) -> a   
dropRight :: Either a b -> b    
dropRight (Right b) = b   
   

dropJust::  Maybe a -> a
dropJust (Just a)  = a

{-

*Main> Right (f1,f2) = runParse parseByte e2
*Main> f1
66
*Main> f2
ParseState {string = "CDE", offset = 2}
*Main> Right (g1,g2) = runParse parseByte f2
*Main> g2
ParseState {string = "DE", offset = 3}
*Main> Right (h1,h2) = runParse parseByte g2
*Main> h2
ParseState {string = "E", offset = 4}
*Main> e1
65
*Main> f1
66
*Main> h1
68
*Main> g1
67
*Main>




*Main> :t dropRight
dropRight :: Either a b -> b

*Main> L.uncons d
Just (65,"BCDE")

d = L.pack[0x41,0x42,0x43,0x44,0x45]
d2 = L.pack[0x51,0x52,0x53,0x54,0x55]

*Main>runParse parseByte (ParseState d 0)
Right (65,ParseState {string = "BCD", offset = 1})

Right (f1,f2) = runParse parseByte e2

*Main> parse parseByte d
Right 65
-}              
-- file: ch10/Parse.hs
   
           
 {-

*Main> d = L8.pack "abcdefg"
*Main> d
"abcdefg"
*Main> :t d
d :: L8.ByteString
*Main>


 
-}
          
           
           
           
           
           
           
           

-- file: ch10/Parse.hs
instance Functor Parse where
    fmap f parser = parser ==> \result ->
                    identity (f result)

-- file: ch10/Parse.hs
w2c :: Word8 -> Char
w2c = chr . fromIntegral

--i2i64 :: Int -> Int64
--i2i64 = integer . fromIntegral


parseByte :: Parse Word8
parseByte =
    getState ==> \initState ->
    case L.uncons (string initState) of
      Nothing ->
          bail "no more input"
      Just (byte,remainder) ->
          putState newState ==> \_ ->
          identity byte
        where newState = initState { string = remainder,
                                     offset = newOffset }
              newOffset = offset initState + 1
              
              
parseByte4 :: Parse Word8
parseByte4 =
    Parse $ 
        \initState ->
    case L.uncons (string initState) of
        Nothing ->
            bail3 initState "no more input"
        Just (byte,remainder) ->
            --Right (byte, newState)
            identity2 byte newState
            where 
                newState = initState { string = remainder,
                                     offset = newOffset }
                newOffset = offset initState + 1
                
parseBytes ::Int64 -> Parse L.ByteString
parseBytes n=
    Parse $ 
        \initState ->
        case L.uncons (string initState) of
        Nothing ->
            Right (L.empty, newState)
            where 
                newState = initState 
        Just (byte,remainder) ->
            Right (bytes, newState)
            where 
                newState = initState { string = remainder,
                                     offset = newOffset }
                newOffset = offset initState + 1
                bytes = L.take n str
                remainder = L.drop n str
                str = string initState
              


           
                
               {-
parseBytes2 ::Int64 -> Parse L.ByteString
parseBytes2 n=
    Parse $ 
    \initState ->
        Right (d,initState)
        where
            byte = L.take n str
            remainder = L.drop n str
            str = string initState
            newState = initState { string = remainder, offset = newOffset }
            newOffset = offset initState + 1
 -}        
           
-- import Control.Applicative
-- fmap :: (a -> b) -> f a -> f b
-- (a -> b) <$> f a -> f b
parseChar :: Parse Char
parseChar = w2c <$> parseByte

--getState :: Parse ParseState
-- file: ch10/Parse.hs
peekByte :: Parse (Maybe Word8)
peekByte = (fmap fst . L.uncons . string) <$> getState

-- file: ch10/Parse.hs
peekChar :: Parse (Maybe Char)
peekChar = fmap w2c <$> peekByte

parseWhile :: (Word8 -> Bool) -> Parse [Word8]
parseWhile p = (fmap p <$> peekByte) ==> \mp ->
               if mp == Just True
               then parseByte ==> \b ->
                    (b:) <$> parseWhile p
               else identity []
               
-- file: ch10/Parse.hs
parseWhileWith :: (Word8 -> a) -> (a -> Bool) -> Parse [a]
parseWhileWith f p = fmap f <$> parseWhile (p . f)


{-
*Main> runParse (parseWhile isMyDigit) (ParseState (L8.pack "123ab45de") 0)
Right ([49,50,51],ParseState {string = "ab45de", offset = 3})
*Main>

*Main> runParse (parseWhileWith w2c isMyDigit2) (ParseState (L8.pack "123ab45de") 0)
Right ("123",ParseState {string = "ab45de", offset = 3})
*Main>
-}               
               
isMyDigit:: Word8 -> Bool
isMyDigit a = if a < 0x30
                then False
                else if a > 0x39
                    then False
                    else
                        True


isMyDigit2:: Char -> Bool
isMyDigit2 a = if a < '0'
                then False
                else if a > '9'
                    then False
                    else
                        True

-- file: ch10/Parse.hs

parseRawPGM =
    parseWhileWith w2c notWhite ==> \header -> skipSpaces ==>&
    assert (header == "P5") "invalid raw header" ==>&
    parseNat ==> \width -> skipSpaces ==>&
    parseNat ==> \height -> skipSpaces ==>&
    parseNat ==> \maxGrey ->
    parseByte ==>&
    parseBytes (fromIntegral (width * height)) ==> \bitmap ->
    identity (Greymap width height maxGrey bitmap)
  where notWhite = (`notElem` " \r\n\t")

parseRawPGM1 =
    parseWhileWith w2c notWhite ==> \header -> 
    identity (Greymap 45 32 34 d)

notWhite :: Char -> Bool
notWhite = (`notElem` " \r\n\t")
{-
*Main>
*Main> content <- L.readFile "p5a.pgm"
*Main> runParse (parseRawPGM1) (ParseState content 0)
Right (Greymap 45x32 34,ParseState {string = " \a\RS\DC3\SO2%-,)'%$\" \US\FS\SUB\CAN\ETB\ESC\DC4\CAN\SYN\DC4\ETB\CAN\EM\SUB\ESC\GS\RS \STX\EM\DC1\STX(\a\ETX.('

-}
parseNat :: Parse Int
parseNat = parseWhileWith w2c isDigit ==> \digits ->
           if null digits
           then bail "no more input"
           else let n = read digits
                in if n < 0
                   then bail "integer overflow"
                   else identity n
                   
(==>) :: Parse a -> (a -> Parse b) -> Parse b

firstParser ==> secondParser  =  Parse chainedParser
  where chainedParser initState   =
          case runParse firstParser initState of
            Left errMessage ->
                Left errMessage
            Right (firstResult, newState) ->
                runParse (secondParser firstResult) newState                   

(==>&) :: Parse a -> Parse b -> Parse b
p ==>& f = p ==> \_ -> f

skipSpaces :: Parse ()
skipSpaces = parseWhileWith w2c isSpace ==>& identity ()

assert :: Bool -> String -> Parse ()
assert True  _   = identity ()
assert False err = bail err

{--}